perm filename XRUN.SAI[X,ALS] blob
sn#089971 filedate 1974-03-05 generic text, type T, neo UTF8
00010 BEGIN "XRUN"
00020 DEFINE ⊂="COMMENT";
00030
00040 ⊂ This program runs another program, BXX, as a separate job and produces
00050 an XGP plot of formant data from the specified file. This program may
00060 be executed directly, in which case it requests info from the TTY, or it
00070 be called into being as a separate job and passed a number specifying
00080 the file to be used. In this second case this program automatically
00090 kills its job on completion;
00100
00110 DEFINE ⊃="⊂";
00120 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130 INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN5,CHAN1,EOF,BRCHR,DOTS,SMOO,
00140 HT,SCALEX,PP,POINTP,FLAG,MUTE,NUM;
00150 INTEGER ARRAY X1,XX2,Y1,YY2[0:10];
00160 STRING FILEP,FILEN,READ,MEMO; BOOLEAN ER;
00170 INTEGER ARRAY SAVE[0:10];
00180 INTEGER ARRAY LFILE[0:127];
00190 INTEGER ARRAY NEW[0:511];
00200 INTEGER ARRAY DPYBUF[0:4096];
00210 INTEGER A1,A2,A3;
00220 LABEL STARTP;
00230 INTEGER DATE,TIME,SCALE;
00240 DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00250 PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00260 "SEP","OCT","NOV","DEC";
00270 STRING ARRAY MONTHS[0:11];
00280
00290
00300 PROCEDURE MEDIAN;
00310
00320 BEGIN
00330
00340 IF (Y1[I]>YY2[I])∧(Y>YY2[I]) THEN BEGIN
00350 IF Y1[I]>Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I];END;
00360
00370 IF (Y1[I]<YY2[I])∧(Y<YY2[I]) THEN BEGIN
00380 IF Y1[I]<Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I]; END;
00390
00400 Y1[I]←YY2[I]; YY2[I]←Y; Y←Y1[I]; X1[I]←XX2[I]; XX2[I]←X; X←X1[I];
00410 END;
00420
00430 INTERNAL STRING PROCEDURE DATIM;
00440 BEGIN
00450 INTEGER DAY,YR,HRS,MIN,SEC;
00460 DAY←(DATE MOD 31)+1;DATE←DATE%31;
00470 YR←1964+DATE%12; SEC←TIME MOD 60;
00480 TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00490 SETFORMAT(-2,0);
00500 RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00510 "-"&CVS(YR)&" "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00520 END;
00530
00540 INTERNAL STRING PROCEDURE WTIM;
00550 BEGIN
00560 DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00570 RETURN(DATIM);
00580 END;
00590
00600 INTERNAL STRING PROCEDURE DATIME;
00610 BEGIN
00620 GETIME;
00630 RETURN(DATIM);
00640 END;
00650
00660
00670 ⊂ Allow 1140 units on a line corresponding to 76 charactters @15 units,
00680 380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00690
00700
00710 PROCEDURE XPLOT;
00720 BEGIN "XPLOT"
00730 REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00740 REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00750 REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00760 EXTERNAL FORTRAN PROCEDURE XSET;
00770 EXTERNAL FORTRAN PROCEDURE XRVEC;
00780 EXTERNAL FORTRAN PROCEDURE XVEC;
00790 EXTERNAL FORTRAN PROCEDURE XIVEC;
00800 EXTERNAL FORTRAN PROCEDURE XIRVEC;
00810 EXTERNAL FORTRAN PROCEDURE XLINE;
00820 EXTERNAL FORTRAN PROCEDURE VERTAX;
00830 EXTERNAL FORTRAN PROCEDURE SWT25;
00840 EXTERNAL FORTRAN PROCEDURE PTX1;
00850 EXTERNAL FORTRAN PROCEDURE XOUT;
00860 EXTERNAL FORTRAN PROCEDURE XFIN;
00870 INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00880 INTEGER IX,IX2,IY,XREF,YREF,X2,Y2,XSAVE,XCUT;
00890 INTEGER MIN,MAX,ERR;
00900
00910 SCALEX←0;
00920
00930 XSET;
00940 MIN←0;
00950 MAX←100;
00960 XREF←400;
00970 YREF←800;
00980 ⊂ HT←400; ⊂ Allowing 2 inches for 100 DB;
00990 ⊂ VERTAX(MIN,MAX,XREF,YREF,HT);
01000
01010 MAX←3000;
01020 YREF←150;
01030 ⊂ HT←600; ⊂ Allowing 3 inches for 3000 hertz;
01040 VERTAX(MIN,MAX,XREF,YREF,HT);
01045 IX←XREF-90; IY←YREF+HT+30; XSTR←"Hertz"; SWT25(IX,IY);
01050 XOUT(XREF-8);
01060 XSAVE←0;
01070
01080 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
01090 LOOKUP(CHAN5,FILEP,ERR);
01100 FILEINFO(SAVE);
01110 IF ERR THEN OUTSTR("FILE "&FILEP&" NOT FOUND"&CRLF);
01120 ARRYIN(CHAN5,LFILE[0],'200);
01130
01140 XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
01150 IX←XREF; IY←YREF-100; SWT25(IX,IY);
01160 READ←WTIM; SETFORMAT(1,0);
01170
01180 XSTR←"The first "&CVS(NUM)&" formants in parameter file "
01190 &FILEP&" (created "&READ&")";
01200 IX←XREF; IY←1450; SWT25(IX,IY);
01210 IF SMOO=0 THEN XSTR←"Mute level at "&CVS(MUTE)&". "&MEMO ELSE
01220 XSTR←"Mute level at "&CVS(MUTE)&" with medial smoothing. "&MEMO;
01230 IX←XREF+100; IY←1420; SWT25(IX,IY);
01240 XSTR←"A.I. Laboratory, Stanford University. "&DATIME;
01250 IX←XREF+200; IY←1390; SWT25(IX,IY);
01260
01270 FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01280 IF LFILE[I]=0 THEN DONE;
01290 L←LFILE[I] LAND '777760000000;
01300 J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01310
01320 X←J*128%SCALE+K*64%SCALE-8; ⊂ X←(J+K%2)*128%32-8;
01330 IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01340 IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01350 IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01360 IY←YREF-70; SWT25(IX,IY); END;
01370
01380 IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01390 XLINE(IX,YREF-20,IX,YREF);
01400 XLINE(IX,YREF,IX2,YREF);
01410 XLINE(IX,YREF-1,IX2,YREF-1);
01420 XLINE(IX,YREF-2,IX2,YREF-2);
01430 XLINE(IX2,YREF,IX2, YREF-20);
01440
01450 END "PONY";
01460 OUTSTR("Text,");
01470
01480 XOUT(XREF-2);
01490
01500 XCUT←IX2+200;
01510
01520
01530 FOR I←0 STEP 1 UNTIL 10 DO BEGIN
01540 SAVE[I]←0; X1[I]←0; XX2[I]←Y1[I]←YY2[I]←0; END;
01550
01560 WHILE EOF=0 DO BEGIN "XDATIN"
01570 FOR I ←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01580 ARRYIN(CHAN5,NEW[0],512);
01590 IF NEW[0]=0 THEN DONE;
01600
01610 FOR I←1 STEP 1 UNTIL NUM DO BEGIN "XPLO"
01620 LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+LY);
01630 FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01640 IF NEW[J]=0 THEN DONE;
01650 X←(NEW[J] LSH -15)%SCALE;
01660 ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01670 ⊂ This corresponds to 512 samples (32*16) per character;
01680
01690 POINTP←POINT(9,NEW[J+1],-1);
01700 FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01710 Y← LDB(POINTP)*5*HT%384; ⊂ 5 inches for 5000 hertz;
01720
01730 IF SMOO=1 THEN MEDIAN; ⊂ Replaces Y and X by previous values with medial smoothing;
01740
01750 DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01760 IF (LDB(POINT(9,NEW[J+2],26)) < MUTE)∨(DX<3)
01770 THEN XIRVEC(DX,DY) ELSE XRVEC(DX,DY);
01780 END;
01790 SAVE[I]←LY;
01800 END "XPLO";
01810
01820 FOR I←6 STEP 1 UNTIL 5 DO BEGIN "XPLO2"
01830 LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+650+LY);
01840 FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01850 IF NEW[J]=0 THEN DONE;
01860 X←(NEW[J] LSH -15)%SCALE;
01870 ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01880 ⊂ This corresponds to 512 samples (32*16) per character;
01890
01900 POINTP←POINT(9,NEW[J+1],-1);
01910 FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01920 Y← LDB(POINTP)*4; ⊂ 2 inches for 100 DB;
01930
01940 DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01950 XRVEC(DX,DY);
01960 END;
01970 SAVE[I]←LY;
01980 END "XPLO2";
01990
02000 WHILE SCALEX<LX DO BEGIN "TIME"
02010 XLINE(XREF+SCALEX,YREF,XREF+SCALEX,YREF+20);
02020 IF (SCALEX≠0)∧(DOTS=0) THEN FOR J←HT%6 STEP HT%6 UNTIL HT DO BEGIN
02030 XLINE(XREF+SCALEX-5,YREF+J,XREF+SCALEX+5,YREF+J);
02040 XLINE(XREF+SCALEX,YREF+J-5,XREF+SCALEX,YREF+J+5); END;
02050 FOR K←1 STEP 1 UNTIL 9 DO BEGIN
02060 IX←XREF+SCALEX+K*2000%SCALE; IF IX>IX2 THEN BEGIN
02070 SCALEX←SCALEX+20000%SCALE;
02080 DONE "TIME";
02090 END;
02100 XLINE(IX,YREF,IX,YREF+10);
02110 IF DOTS=0 THEN FOR J←HT%6 STEP HT%6 UNTIL HT DO BEGIN
02120 XLINE(IX-2,YREF+J,IX+2,YREF+J); XLINE(IX,YREF+J-2,IX,YREF+J+2); END;
02130 END;
02140 SCALEX←SCALEX+20000%SCALE;
02150 END "TIME";
02160
02170 XOUT(LX-20); OUTSTR(CVS(LX)&",");
02180
02190 IF X=0 THEN DONE "XDATIN";
02200 SAVE[0]←LX;
02210 END "XDATIN";
02220 CLOSE(CHAN5);
02230 XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
02240 IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
02250
02260 XFIN;
02270 END "XPLOT";
02280
00010 CHAN1←1; CHAN5←5;
00020 SCALE←20; DOTS←SMOO←0; MEMO←""; HT←600;
00030
00040
00050
00060 STDBRK(1);
00070 STARTP:
00080 MUTE←60; NUM←3;
00090 CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00100 LOOKUP(CHAN1,"NUMBER.TMP",ER);
00110 IF ER THEN BEGIN
00120 OUTSTR("This program graphs formants on the XGP from a parameter file."&CRLF);
00130 OUTSTR("The following set-up commands (with CR) "
00140 &"may be given:"&CRLF);
00150 OUTSTR(" M# set MUTE level to # (default value 60)"&CRLF&
00160 " R# set horizontal scale reduction factor (default value 20)"&CRLF&
00165 " V# set vertical size in 1/200 inch (default value 600)"&CRLF&
00170 " D delete scale points (default condition with points)"&CRLF&
00180 " S medial smooth (default condition with no smoothing)"&CRLF&
00190 " C typed comment to CR (60 char. max.) will appear on graph"&CRLF&
00200 " N# set number of formants (default value 3)."&CRLF);
00220 OUTSTR("A number (without letter) terminates condition-setting and specifies the file to use."
00230 &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00240 SETFORMAT(1,0); FLAG←0; X←0;
00250 WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command "); READ←INCHWL;
00260 IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00270 IF READ[1 TO 1]="R" THEN BEGIN SCALE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00280 IF READ[1 TO 1]="V" THEN BEGIN HT←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00290 IF READ[1 TO 1]="S" THEN BEGIN SMOO←1; CONTINUE "TYPE";END;
00300 IF READ[1 TO 1]="D" THEN BEGIN DOTS←1;CONTINUE "TYPE";END;
00310 IF READ[1 TO 1]="C" THEN BEGIN MEMO←READ[2 TO 61];CONTINUE "TYPE";END;
00320 IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00330 DONE; END "TYPE";
00340 IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00350 END ELSE BEGIN
00360 PP←CVD(INPUT(CHAN1,1));
00370 MEMO←INPUT(CHAN1,1);
00380 CLOSE(CHAN1);
00390 END;
00400
00410 FILEP←"SEG"&CVS(PP)&".SYN[SYN,ALS]";
00420
00430 XPLOT;
00440 PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF);
00450
00460 END "XRUN";